home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / Modes / cMode.tcl < prev    next >
Encoding:
Text File  |  1999-01-28  |  21.3 KB  |  677 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "cMode.tcl"
  6.  #                    created: 19/4/96 {4:53:38 pm}    
  7.  #                 last update: 19/1/1999 {1:07:41 pm}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  # ###################################################################
  15.  ##
  16.  
  17. alpha::mode C 1.2.2 dummyC { *.r } \
  18.   {electricReturn electricBraces electricSemicolon}
  19. alpha::mode C++ 1.2.2 dummyC++ \
  20.   {*.H *.c *.h *.cc *.cp *.cpp *.CPP *.C *.pch *.pch++ *.icc *.exp} \
  21.   {electricReturn electricBraces electricSemicolon}
  22.  
  23. # not really sure this is required any more
  24. # the CW menu registers are proc to call cw IDE.
  25. hook::register saveHook modified "C" "C++"
  26.  
  27. proc dummyC {} {}
  28. proc dummyC++ {} {}
  29.  
  30. newPref f elecColon {1} C
  31. newPref v leftFillColumn {3} C
  32. newPref v prefixString {//} C
  33. newPref f elecElse {1} C
  34. newPref f wordWrap {0} C
  35. newPref v funcExpr {^[^ \t\(#\r/@].*\(.*\)$} C
  36. newPref v parseExpr {\b([_:\w]+)\s*\(} C
  37. newPref v wordBreak {[_\w]+} C
  38. newPref v wordBreakPreface {[^_\w]} C
  39. newPref f autoMark 0 C
  40. newPref v stringColor green C
  41. newPref v commentColor red C
  42. newPref v funcColor yellow C
  43. newPref v keywordColor blue C
  44. newPref v CWCompSig CWIE C
  45. newPref v CWDbgSig MWDB C
  46. newPref v SymCompSig KAHL C
  47. newPref v SymDbgSig {◊LSD} C
  48. newPref f includeMenu {1} C
  49. newPref f launchIDEifRequired {1} C
  50. newPref v sourceSuffices { .c } C
  51. newPref v headerSuffices { .h } C
  52. newPref v indentComments "code 0" C
  53. newPref v indentMacros "fixed 0" C
  54. newPref v IDE 0 C "" [list "CodeWarrior" "Symantec" "none"] index
  55. newPref f useFasterButWorseIndentation 0 C
  56. set C::commentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  57. set cPreRegexp        {^\#[\t ]*[a-z]*}
  58. set cKeyWords {
  59.     void break register short enum extern int for if while struct static 
  60.     long continue switch case char unsigned double float return else 
  61.     default goto do pascal Boolean typedef volatile union auto sizeof 
  62.     size_t
  63. }
  64. if {[info exists Cwords]} {set cKeyWords [concat $cKeyWords $Cwords]}
  65. regModeKeywords -e {//} -b {/*} {*/} -c $CmodeVars(commentColor) \
  66.   -f $CmodeVars(funcColor) -k $CmodeVars(keywordColor) \
  67.   -s $CmodeVars(stringColor) -m {#} C $cKeyWords
  68.  
  69. #================================================================================
  70.  
  71. newPref f elecColon {1} C++
  72. newPref v leftFillColumn {3} C++
  73. newPref v prefixString {//} C++
  74. newPref v wordBreak {[\w_]+} C++
  75. newPref v wordBreakPreface {[^_\w]} C++
  76. newPref f elecElse {1} C++
  77. newPref f wordWrap {0} C++
  78. newPref v funcExpr {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9~_]+(<[^>]*>)?::[-A-Za-z0-9~_+= <>\|\*/]+|[A-Za-z0-9~_]+)[ \t\r]*\(} C++
  79. newPref v parseExpr {\b([_:\w]+)\s*\(} C++
  80. newPref f autoMark 0 C++
  81. newPref v stringColor green C++
  82. newPref v commentColor red C++
  83. newPref v keywordColor blue C++
  84. newPref v funcColor yellow C++
  85. newPref v CWCompSig CWIE C++
  86. newPref v CWDbgSig MWDB C++
  87. newPref v SymCompSig KAHL C++
  88. newPref v SymDbgSig {◊LSD} C++
  89. newPref f includeMenu {1} C++
  90. newPref f launchIDEifRequired {1} C++
  91. newPref v sourceSuffices { .cc .cp .cpp .c .icc .C } C++
  92. newPref v headerSuffices { .h .hh } C++
  93. # These three are pairs:
  94. newPref v indentComments "code 0" C++ "" indentationTypes varitem
  95. newPref v indentC++Comments "code 0" C++ "" indentationTypes varitem
  96. newPref v indentMacros "fixed 0" C++ "" indentationTypes varitem
  97. newPref v IDE 0 C++ "" [list "CodeWarrior" "Symantec" "none"] index
  98. newPref f useFasterButWorseIndentation 0 C++
  99. newPref folder universalHeadersFolder "" C++
  100.  
  101. proc C++::openUniversalHeader {} {
  102.     global universalHeadersFolder tabSize
  103.     set filename [prompt::statusLineComplete "Open which header" \
  104.       [list file::completeFromDir $universalHeadersFolder] -nocache \
  105.       -tryuppercase]
  106.     set old $tabSize
  107.     set tabSize 4
  108.     file::openQuietly [file join $universalHeadersFolder $filename]
  109.     set tabSize $old
  110. }
  111.  
  112. Bind 'q' <o> C++::openUniversalHeader C++
  113.  
  114. set C++::commentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  115.  
  116. set {c++KeyWords} {
  117.     new delete explicit class friend protected private public template try 
  118.     catch throw operator const mutable virtual asm inline this and and_eq 
  119.     bitand bitor compl not or or_eq xor xor_eq not_eq wchar_t bool true 
  120.     false bool inline mutable static_cast dynamic_cast reinterpret_cast 
  121.     typeid using namespace inherited
  122. }
  123. if {[info exists {C++words}]} {
  124.     set {c++KeyWords} [concat ${c++KeyWords} ${C++words} $cKeyWords]
  125. } else {
  126.     set {c++KeyWords} [concat ${c++KeyWords} $cKeyWords]
  127. }
  128.  
  129. regModeKeywords -e {//} -b {/*} {*/} -c [set C++modeVars(commentColor)] -f [set C++modeVars(funcColor)] -k [set C++modeVars(keywordColor)] -s [set C++modeVars(stringColor)] -m {#} {C++} ${c++KeyWords}
  130. unset cKeyWords
  131. unset {c++KeyWords}
  132.  
  133. proc C++::DblClick {from to shift option control} {    
  134.     if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
  135.     return [file::tryAndOpen $inc]
  136.     }
  137.     
  138.     select $from $to
  139.     set text [getSelect]
  140.     
  141.     global tagFile
  142.     set lines [grep "^$text'" $tagFile]
  143.     if {[regexp {'(.*)'(.*[^\t])(\t)+∞} $lines dummy one two]} {
  144.     file::openQuietly $one
  145.     set inds [search -s -f 1 -r 0 "$two" [minPos]]
  146.     display [lindex $inds 0]
  147.     eval select $inds
  148.     } else {
  149.     app::launchFore DanR
  150.     AEBuild {'DanR'} DanR {REF } "----" "“$text”"
  151.     }
  152. }
  153.  
  154. proc C++::parseFuncs {} {
  155.     global mode sortFuncsMenu
  156.     global funcExpr parseExpr
  157.     
  158.     set pos [minPos]
  159.     while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  160.     if {[regexp $parseExpr [getText [car $res] [cadr $res]] dummy word]} {
  161.         lappend m [list $word [car $res]]
  162.     }
  163.     set pos [cadr $res]
  164.     }
  165.     if {$sortFuncsMenu} {
  166.     regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  167.     } else {
  168.     regsub -all "\[\{\}\]" $m "" m
  169.     }    
  170.     set files ""
  171.     foreach f [getIncludeFiles] {
  172.     lappend files $f -1
  173.     }
  174.     return [concat $files [list "(-" 0] $m]
  175. }
  176.  
  177. # for C mode
  178.  
  179. proc C::DblClick {args} { eval C++::DblClick $args }
  180.  
  181. proc C::parseFuncs {} {
  182.     return [C++::parseFuncs]
  183. }
  184.  
  185.  
  186. #############################################################################
  187. #                                                                            #
  188. #    Stuff above    this point has only    minor modifications    from the original    #
  189. #    "cMode.tcl", stuff below is    largely    or totally new.                        #
  190. #                                                                            #
  191. #############################################################################
  192.  
  193. # ◊◊◊◊ File marking ◊◊◊◊ #
  194.  
  195. ## 
  196.  # -------------------------------------------------------------------------
  197.  #     
  198.  # "C++::MarkFile" --
  199.  #    
  200.  #    Improved version which handles templates, operators    etc.
  201.  #    Makes use of the new mark menu in Alpha    6.5 which can handle
  202.  #    more weird characters.  Handles most 'operator =+-*...' functions
  203.  #  for C++
  204.  #  
  205.  #  Better marking of templates recently added.
  206.  # -------------------------------------------------------------------------
  207.  ##
  208. proc C++::MarkFile {} {
  209.     if {[file extension [win::Current]] == ".exp"} { return }
  210.     set pos [minPos]
  211.     set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@\*\].*\[ \t\]+\\*?)?(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?\[-A-Za-z0-9~_+= <>\|\\*/\]+|\[A-Za-z0-9~_\]+)\[ \n\t\r\]*\\()\[^(\]"
  212.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  213.     if [catch {search -s -f 0 -r 1 -m 0 -l [lindex $res 0] -i 0 \
  214.       {[ *][a-zA-Z]} [set pos [pos::math [lindex $res 1] + 1]]} start] {
  215.         set start [lindex $res 0]
  216.         if {[regexp "^\[A-Za-z0-9~_\]+\[ \t\r\n\]*\\(" \
  217.           [getText $start [nextLineStart $start]] thistext]} {
  218.         # nothing
  219.         } else {
  220.         continue
  221.         }
  222.         
  223.     } else {
  224.         set start [lindex $start 0]
  225.         set thistext [getText $start $pos]
  226.     }
  227.     #regexp doesn't like carriage returns or tabs
  228.     #if the open paren was the last character on the line the selected text 
  229.     #included the last carriage return as well
  230.     #trim this off now that it is changed into a space
  231.     regsub -all "\[\r\n\t\]" [string trimright $thistext] " " thistext
  232.     if {[regexp "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?\[-A-Za-z0-9~_+= <>\|\*/\]+|\[A-Za-z0-9~_\]+)\[ \t\]*\\(" $thistext dummy word]} {
  233.         if { [string first "::" $word] != -1 } {
  234.         regsub {(<\w+>)?::} $word " " it
  235.         set l [lindex $it 0]
  236.         if { $l == [lindex $it 1] } {
  237.             set word "Construct '$l'"
  238.         } elseif { "~$l" == [lindex $it 1] } {
  239.             set word "Destruct '$l'"
  240.         }
  241.         }
  242.         set inds($word) [lineStart [expr $start - 1]]
  243.     }
  244.     }
  245.     if {[info exists inds]} {
  246.     foreach f [lsort -ignore [array names inds]] {
  247.         set next [nextLineStart $inds($f)]
  248.         set it $f
  249.         if {[string length $it] > 57} { set it "[string range $it 0 53]..." }
  250.         setNamedMark "${it}" "$inds($f)" $next $next
  251.     }
  252.     }
  253. }
  254.  
  255. proc C::MarkFile {} { C++::MarkFile }
  256.  
  257.  
  258. # ◊◊◊◊ Indentation routines ◊◊◊◊ #
  259.  
  260. proc C::indentLine {} {C++::indentLine}
  261.  
  262.  ## 
  263.   # -------------------------------------------------------------------------
  264.   #     
  265.   #    "C++indentLine" --
  266.   #    
  267.   #     More sophisticated    version    of Pete's.    Handles    things like    '(...)'
  268.   #     expressions split over    multiple lines,    if/elseif/else both    with and
  269.   #     without curly braces, multiple    line stream    manipulation with '<<'
  270.   #     or    '>>', C and C++ style comments, ...  Assumes indentation is '4'
  271.   #   but any tab-size may be used.
  272.   #     
  273.   #     Current bugs: multi-line ',' separated lists are poorly indented.
  274.   #
  275.   #  Problems:
  276.   #   matchIt's limit doesn't seem to work, so if there is no match and we're
  277.   #   in a large file, we wait up to seconds sometimes.  Alpha bug.
  278.   #           
  279.   #     Currently checking whether we're in a /*...*/ comment is quite
  280.   #   time consuming.  It would be nice if Alpha supplied a hook to do
  281.   #   this for us.
  282.   #   
  283.   #    Results:
  284.   #     Indents the current line correctly    ;-)    for    C, C++ coding
  285.   #     
  286.   # --Version--Author------------------Changes-------------------------------  
  287.   #      1.0      Pete Keleher              original
  288.   #    2.0     <darley@fas.harvard.edu> updated as described above.
  289.   #    2.1     <darley@fas.harvard.edu> faster, better, uses positions not strings
  290.   #    2.2     <darley@fas.harvard.edu> uses 'correctIndentation' sub proc
  291.   # -------------------------------------------------------------------------
  292.   ##
  293. proc C++::indentLine {} {
  294.     global gotoEol
  295.     set gotoEol 0
  296.     
  297.     # preliminaries
  298.     set beg [lineStart [getPos]]
  299.     # are we in a C comment /*...*/ if so indent specially and return
  300.     # we really need to work out how to put this in 'correctIndentation'
  301.     if {![catch {C_inCComment $beg} comment]} {
  302.     set fChar [search -s -f 1 -r 1 "\[^ \t\r\n\]" $beg]
  303.     if { [lookAt [lindex $fChar 0]] == "*" } {
  304.         return [eval C_indentCommentLine [list $beg] $comment]
  305.     }
  306.     }
  307.     set text [getText $beg [nextLineStart $beg]]
  308.     if {[regexp "^\[ \t\]*" $text white]} {
  309.     set len [string length $white]
  310.     set rest [string range $text $len end]
  311.     } else {
  312.     set white ""
  313.     set rest ""
  314.     set len 0
  315.     }
  316.     # get indentation level    
  317.     set lwhite [text::indentOf [C++::correctIndentation [getPos] [string trim $rest]]]
  318.     if {$white != $lwhite} {
  319.     replaceText $beg [pos::math $beg + $len] $lwhite
  320.     }
  321.     if {$gotoEol} {
  322.     goto [pos::math [nextLineStart $beg] - 1]
  323.     } else {
  324.     goto [pos::math $beg + [string length $lwhite]] 
  325.     }
  326.     
  327. }
  328. proc C::correctIndentation {args} {eval C++::correctIndentation $args}
  329. ## 
  330.  # -------------------------------------------------------------------------
  331.  # 
  332.  # "C++::correctIndentation" --
  333.  # 
  334.  #  Known bugs:
  335.  #  
  336.  #  Lines which contain a URL with :// embedded tend to be considered
  337.  #  a ':' followed by a comment, and are indented as if they were
  338.  #  part of a 'case://comment' statement which is wrong.
  339.  # -------------------------------------------------------------------------
  340.  ##
  341. proc C++::correctIndentation {pos {nextword ""}} {
  342.     global gotoEol
  343.     # preliminaries
  344.     set beg [lineStart $pos]
  345.     set nextCh [string range $nextword 0 3]
  346.     set nextC [string index $nextCh 0]
  347.     set nextP [string range $nextCh 0 1]
  348.     # check for forced indentation of C, C++ comments and '#' macros
  349.     set ind "code 0"
  350.     switch -- $nextC {
  351.     "\#" {
  352.         global indentMacros
  353.         set ignore_trailers ""
  354.         set ind $indentMacros
  355.     }
  356.     "/" {
  357.         global indentComments indentC++Comments
  358.         set ignore_trailers ""
  359.         if {$nextP == "/*"} {set ind $indentComments}
  360.         if {$nextP == "//"} {set ind ${indentC++Comments}}
  361.     }
  362.     }
  363.     if {[lindex $ind 0] == "fixed" } {
  364.     # force indentation to given level
  365.     return [lindex $ind 1]
  366.     }
  367.     
  368.     # (1) first we get the indent of the last line:
  369.     # this may involve looking back a fair way
  370.     set lst [C_prevCodeIndent [pos::math $beg - 1]]
  371.     
  372.     if {[pos::compare [set pstart [lindex $lst 0]] == [minPos]]} {
  373.     return 0
  374.     }
  375.     set lwhite [posX [pos::math [lindex $lst 1] - 1]]    
  376.     # have we just finished an if-elseif-else with no '{}'?
  377.     if {$nextCh == "else"} {set iselse 1} else { set iselse 0}
  378.     if ![C_isLineNBI $pstart] {
  379.     incr lwhite [C_recurseNoBraceIndent $pstart 0 $iselse]
  380.     }
  381.     if { [set multi [C_isLineMulti $pstart]] != "-1" } {
  382.     set lwhite $multi
  383.     }
  384.     
  385.     # (2) now we indent this line accordingly
  386.     
  387.     set pbeg [prevLineStart $beg]
  388.     set backpos [nextLineStart [lindex $lst 0]]
  389.     # is there a comment at the end of the line? if so scan back to the character we want
  390.     if ![catch {search -s -f 0 -r 1 -l $pbeg "//\[^\r\n\]*\[\n\r\]" $beg} compos] {
  391.     set compos [lindex $compos 0]
  392.     if {[pos::compare $compos > $pbeg]} {
  393.         set backpos [pos::math $compos + 1]
  394.     }    
  395.     }
  396.     global indentationAmount
  397.     if {[pos::compare [set backpos [pos::math $backpos - 2]] > [minPos]]} {
  398.     set lst [search -s -f 0 -r 1 -m 0 "\[^ \t\r\n\]" $backpos]
  399.     switch -- [lookAt [lindex $lst 0]] {
  400.         "\{" {
  401.         incr lwhite $indentationAmount
  402.         } 
  403.         ":" {
  404.         incr lwhite [expr $indentationAmount /2]
  405.         } 
  406.         "\)" {
  407.         # see if we're in a if-elseif-else with no '{}' and indent
  408.         if [C_isLineNBI $pstart] {
  409.             incr lwhite $indentationAmount
  410.         }
  411.         }
  412.         "e" {
  413.         if { [getText [pos::math [lindex $lst 0] - 3] \
  414.           [pos::math [lindex $lst 0] + 1]] == "else" } {
  415.             if [C_isLineNBI $pstart] {
  416.             incr lwhite $indentationAmount
  417.             }
  418.         }
  419.         
  420.         }
  421.     }
  422.     }
  423.     
  424.     switch -- $nextC {
  425.     "\}" {
  426.         incr lwhite [expr -$indentationAmount]
  427.     }
  428.     "<" -
  429.     ">" {            
  430.         # indent for '<<' and '>>' in multi-line C++ stream manipulation
  431.         if {$nextP == "<<" || $nextP == ">>"} {
  432.         set strm [search -s -f 1 -r 1 "^\[^${nextC}\]+${nextP}" $pbeg]
  433.         set lwhite [posX [pos::math [lindex $strm 1] - 2]]
  434.         set gotoEol 1
  435.         }
  436.     }
  437.     }
  438.     # Check if we're in a multi-line '(.....)' if so align to start
  439.     global useFasterButWorseIndentation
  440.     if {!$useFasterButWorseIndentation && ![catch {matchIt ")" $beg 200} paren]} {
  441.     set lwhite [posX [pos::math $paren + 1]]
  442.     set gotoEol 1
  443.     }
  444.     
  445.     if {[regexp "^(case\[ \t\].*|\[a-zA-Z\]+):" $nextword] && $lwhite > 3 \
  446.       && ![info exists ignore_trailers]} {
  447.     incr lwhite [expr -$indentationAmount/2]
  448.     }
  449.     # get indentation level    
  450.     return [incr lwhite [lindex $ind 1]]
  451. }
  452.  
  453. ## 
  454.  # -------------------------------------------------------------------------
  455.  #     
  456.  # "recurseNoBraceIndent" --
  457.  #    
  458.  #    Scans back until we    no longer have a 'no brace indent'.    
  459.  #    A 'no brace indent' is    a 'for', 'if' etc which    didn't use
  460.  #    '{ ... }'
  461.  # -------------------------------------------------------------------------
  462.  ##
  463. proc C_recurseNoBraceIndent {pos offset {iselse 0}} {
  464.     set pos [prevLineStart $pos]
  465.     if [C_isLineNBI $pos] {
  466.     if {$iselse} {
  467.         set p [text::firstNonWsPos $pos]
  468.         set t [getText $p [pos::math $p + 10]]
  469.         if [regexp  "(else\[ \t\]+)?if.*" $t] {
  470.         return [expr {$offset -4}]
  471.         }
  472.     }
  473.     return [C_recurseNoBraceIndent $pos [incr offset -4] $iselse]
  474.     }
  475.     return $offset
  476.     
  477. }
  478.  
  479. ## 
  480.  # -------------------------------------------------------------------------
  481.  #     
  482.  # "isLineNBI" --
  483.  #    
  484.  #    Tests if the given line is a 'no brace indent'.
  485.  # -------------------------------------------------------------------------
  486.  ##
  487. set C_recNBI "^\[ \t\]*((\}?\[ \t\]*(if|else\[ \t\]+if)|for)\[ \t\]*\\(.*\\)|\}?\[ \t\]*else)\[ \t\]*(//\[^\r\n\]*)?\[ \t\]*$"
  488. proc C_isLineNBI {pos} {
  489.     global C_recNBI
  490.     if {![catch {search -s -f 1 -r 1 -l [pos::math [nextLineStart $pos] + 2] $C_recNBI $pos} ifelse] } {
  491.     if {[pos::compare $pos == [lindex $ifelse 0]]} {
  492.         return 1 
  493.     }
  494.     }
  495.     return 0
  496. }
  497.  
  498. # use 'catch' to call this proc: error = no, otherwise returns st,end pos
  499. proc C_inCComment {pos} {
  500.     set cS [search -s -f 0 -r 0 -l [pos::math $pos - 1000] "/*" $pos]
  501.     set cE [search -s -f 1 -r 0 -l [pos::math $pos + 1000] "*/" [lindex $cS 1]]
  502.     if {[pos::compare $pos >= [lindex $cE 1]] } {
  503.     error "No"
  504.     } else {
  505.     return "[lindex $cS 0] [lindex $cE 1]"
  506.     }
  507. }
  508.  
  509. # look for '<<' and '(...)' multi lines.
  510. proc C_isLineMulti {pos} {
  511.     # look for multi-line '(...)'
  512.     if { ![catch {search -s -f 0 -r 1 -l $pos {\).*$} [nextLineStart $pos]} paren] \
  513.       && [pos::compare [nextLineStart $pos] == [pos::math [lindex $paren 1] + 1 ]] } {
  514.     if {[catch {matchIt "\)" [pos::math [lindex $paren 0] - 1] 200} realStart]} {
  515.         return -1
  516.     }
  517.     if {[pos::compare [lineStart $realStart] != [lineStart [lindex $paren 0]]] } {
  518.         set lst [search -s -f 0 -r 1 -i 0 "^\[ \t\]*\[^ \t\r\n\]" $realStart]
  519.         return [posX [pos::math [lindex $lst 1] - 1]]
  520.     }
  521.     }
  522.     # look for multi-line '<<' or '>>'
  523.     set p $pos
  524.     while {![catch {search -s -f 1 -r 1 -l [nextLineStart $p] "^\[ \t\]*(<<|>>)" $p} strm] } {
  525.     set p [prevLineStart $p]
  526.     }
  527.     if { $p != $pos } {
  528.     set lst [search -s -f 1 -r 1 -i 0 "^\[ \t\]*\[^ \t\r\n\]" $p]
  529.     return [posX [pos::math [lindex $lst 1] - 1]]
  530.     }
  531.     
  532.     return -1
  533.     
  534. }
  535.  
  536. ## 
  537.  # -------------------------------------------------------------------------
  538.  #   
  539.  # "C_indentCommentLine" --
  540.  #  
  541.  #  Indents a line within a multi-line /* ... */ comment correctly.
  542.  # -------------------------------------------------------------------------
  543.  ##
  544. proc C_indentCommentLine {beg cS cE} {
  545.     set lwhite [text::minSpaceForm [getText [lineStart $cS] $cS]]
  546.     if {[pos::compare $beg != [lineStart [lindex $cE 0]]] \
  547.       || [text::firstNonWs [pos::math $beg - 1]] == "*" } {
  548.     append lwhite " "    
  549.     }
  550.     
  551.     set text [getText $beg [nextLineStart $beg]]
  552.     regexp "^\[ \t\]*" $text white
  553.     set len [string length $white]
  554.     if {$white != $lwhite} {
  555.     replaceText $beg [pos::math $beg + $len] $lwhite
  556.     }
  557.     goto [pos::math $beg + [expr {[string length $lwhite] +1}]]
  558. }
  559.  
  560.  
  561. ## 
  562.  # -------------------------------------------------------------------------
  563.  #   
  564.  # "C_prevCodeIndent" --
  565.  #  
  566.  #  Find the indent of the previous line
  567.  #  -  If it's the start of the file, return 0 0 (special case)
  568.  #  else
  569.  #  -  if it's a C++ comment, keep looking backwards (so you can offset
  570.  #     C++ comments if you so desire)
  571.  #  -  if it's a C comment, get the indentation of the '/*' not some
  572.  #     intermediate point.
  573.  # -------------------------------------------------------------------------
  574.  ##
  575. proc C_prevCodeIndent {pos} { 
  576.     if {[pos::compare $pos == [minPos]] \
  577.       || ([catch {search -s -m 0 -f 0 -r 1 -i 0 "^\[ \t\]*\[^ \t\r\n\]" $pos} p]) || $p == "[minPos] [minPos]" } {
  578.     return [list [minPos] [pos::math [minPos] + 1]]
  579.     } else {
  580.     set pp [doubleLookAt [pos::math [lindex $p 1] - 1]]
  581.     if { $pp == "//" } {
  582.         return [C_prevCodeIndent [pos::math [lindex $p 0] - 1]]
  583.     } elseif { [string index $pp 0] == "#" } {
  584.         return [C_prevCodeIndent [pos::math [lindex $p 0] - 1]]
  585.     } elseif { $pp == "*/" } {
  586.         return [C_prevCodeIndent [lindex \
  587.           [search -s -f 0 -r 0 "/*" [pos::math [lindex $p 0] - 1]] 0]]
  588.     } elseif { ![catch {set comment [C_inCComment [lindex $p 0]]} ] } {
  589.         return [C_prevCodeIndent [pos::math [lineStart [lindex $comment 0]] - 1]]
  590.         #return [text::indentation [lindex $comment 0]] (old style)
  591.     }
  592.     }
  593.     return $p
  594. }
  595.  
  596.  
  597. # ◊◊◊◊ Electric routines ◊◊◊◊ #
  598.  
  599. proc C::carriageReturn {} {C++::carriageReturn}
  600. proc C::OptionTitlebar {} {C++::OptionTitlebar}
  601. proc C::OptionTitlebarSelect {item} {C++::OptionTitlebarSelect $item}
  602.  
  603. ## 
  604.  # -------------------------------------------------------------------------
  605.  #     
  606.  # "C++::carriageReturn" --
  607.  #    
  608.  #    Called by the general routine 'carriageReturn'.    We know    no selection 
  609.  #    exists, and we are not inside a block comment.
  610.  # -------------------------------------------------------------------------
  611.  ##
  612. proc C++::carriageReturn {} {
  613.     if {[lookAt [pos::math [getPos] - 1]] == ":"} {
  614.     if { [lookAt [getPos]] == "\r" } {
  615.         bind::IndentLine
  616.         endOfLine
  617.         insertText "\r"
  618.     } else {
  619.         set pos [getPos]
  620.         endOfLine
  621.         set t [getText $pos [getPos]]
  622.         replaceText $pos [getPos] ""
  623.         bind::IndentLine
  624.         endOfLine
  625.         insertText "\r"
  626.         insertText $t
  627.     }
  628.     } else {
  629.     insertText "\r"
  630.     }
  631.     catch {bind::IndentLine}
  632. }
  633.  
  634. proc C++::OptionTitlebar {} {
  635.     if {![catch {C++::tryIDEget} ret] && ![regexp {\(No} $ret] } { return $ret }
  636.     # else just scan through, provided the scan will function
  637.     set cid [scancontext create]
  638.     set lines {}
  639.     scanmatch $cid {#.*include.*(<|")(.*)(>|")}  {lappend lines $matchInfo(submatch1)}
  640.     set fid [open [win::Current] "r"]
  641.     scanfile $cid $fid
  642.     close $fid
  643.     scancontext delete $cid
  644.     return [lsort -ignore $lines]
  645. }
  646.  
  647. proc C++::OptionTitlebarSelect {fname} {
  648.     C++::tryIDEedit $fname
  649. }
  650.  
  651. proc C++::tryIDEget {} {
  652.     global IDE
  653.     switch $IDE {
  654.     1 {thinkGetIncludeFiles}
  655.     0 {cw::getIncludeFiles}
  656.     2 {error "No IDE at all!"}
  657.     }
  658. }
  659.  
  660. proc C++::tryIDEedit {fname} {
  661.     global IDE
  662.     switch $IDE {
  663.     1 {thinkEditIncludeFile $fname}
  664.     0 {cw::editIncludeFile $fname}
  665.     2 {error "No IDE at all!"}
  666.     }
  667. }
  668.  
  669.  
  670.  
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.